home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
DB_CLIPP
/
3032.ZIP
/
RLIB20.ZIP
/
RL_SAYIN.PRG
< prev
next >
Wrap
Text File
|
1989-02-18
|
6KB
|
95 lines
* Function..: SAYINBOX
* Author....: Richard Low
* Syntax....: SAYINBOX( [color,] line1 [,line2, line3...] [, seconds ] )
* Returns...: Nothing.
* Parameters: color .... Optional variable or constant indicating the screen
* color to use in the form 'W/N'. This variable is
* deemed to be a color setting if the 2nd, 3rd, or 4th
* character is the '/' character. The default color
* is WHITE foreground on RED background.
* line1..... The lines to be displayed.
* seconds... Optional timeout in seconds
* Notes.....: Displays a multi-line message in a window centered on screen.
FUNCTION SAYINBOX
PARAMETERS p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12
PRIVATE f_pcount, f_color, f_lines, f_indexp, f_brows, f_bcols, f_top,;
f_bottom, f_widest, f_x, f_pname, f_left, f_rite, f_window,;
f_incolor, f_saverow, f_savecol, f_pausing
f_pcount = PCOUNT() && get param count, multiple calls to PCOUNT() do not work!
f_pname = 'p' + LTRIM(STR(f_pcount,2,0)) && get name of last parameter
f_pausing = .F. && no pause by default
IF TYPE(f_pname) = 'N' && if last parameter is numeric
f_pausing = .T. && flag to save the screen
f_seconds = &f_pname && it is number of seconds to pause
f_pcount = f_pcount - 1 && decrement parameter count
ENDIF
f_color = SETCOLOR() && default color is current color
f_lines = f_pcount && 'parameter to display' count; assume each param is a line to display
f_indexp = 1 && pointer to show which parm line to print
f_saverow = ROW() && save cursor position for restoration
f_savecol = COL() && on return
IF STR(AT('/',p1),1,0) $ '234' && if 1st parm is a color setting, a '/' will be at position 2,3, or 4
f_color = p1 && use 1st parameter as color setting
f_indexp = 2 && change parm pointer to next one
f_lines = f_pcount - 1 && adjust 'parameter to display' count
ENDIF
f_brows = 1 && number of blank rows above and below message
f_bcols = 5 && blank columns on either side of messages
f_top = (10 + f_brows) - ROUND(f_lines / 2, 0) && put in middle of screen with 2 lines above and below
f_bottom = f_top + (2 * f_brows) + f_lines + 1 && calculate bottom row of window
f_widest = 10 && widest window width default is 10 columns
FOR f_x = f_indexp TO f_pcount && get widest width for window
f_pname = 'p' + LTRIM(STR(f_x,2,0))
f_widest = MAX( f_widest, LEN(&f_pname) )
NEXT f_x
f_widest = MIN( f_widest + (2 * f_bcols), 77 ) && pad with (bcol) spaces on both sides, max width is 77 columns
f_left = (80 - f_widest) / 2 && calculate left column position
f_rite = f_left + f_widest + 1 && calculate right column of window
IF f_pausing && if we are to pause and restore screen
f_window = SAVESCREEN(f_top,f_left,f_bottom,f_rite) && save what is underneath
f_retval = ' ' && no need to save window coordinates
ELSE
f_retval = CHR(f_top)+CHR(f_left)+CHR(f_bottom)+CHR(f_rite)+;
SAVESCREEN(f_top,f_left,f_bottom,f_rite) && save window coordinates as 4 byte string and contents
ENDIF
f_incolor = SETCOLOR(f_color) && save old color an set to white on red, or color specified
SCROLL( f_top, f_left, f_bottom, f_rite, 0 ) && clear screen and paint in designated color
@ f_top,f_left,f_bottom,f_rite BOX '┌─┐│┘─└│' && draw box around window
FOR f_x = f_indexp TO f_pcount && get widest width for window
f_pname = 'p' + LTRIM(STR(f_x,2,0)) && build name of parameter
@ f_top+f_brows+IF( f_lines=f_pcount, f_x, f_x-1 ),;
(80-LEN(&f_pname))/2 SAY SUBSTR(&f_pname,1,65) && say it in the center of screen
NEXT f_x
IF f_pausing && if we are to pause and restore screen
INKEY(f_seconds) && wait that many seconds
RESTSCREEN(f_top,f_left,f_bottom,f_rite,f_window) && restore what was underneath
ENDIF
@ f_saverow,f_savecol SAY '' && re-position the cursor to where it was on entry
SETCOLOR(f_incolor) && restore old color
RETURN f_retval
* Function..: POPBOX
* Author....: Richard Low
* Syntax....: POPBOX( boxstring )
* Returns...: True if sucessful, false otherwise
* Parameters: Specialized string returned by SAYINBOX(). Used to restore a
* section of screen overwritten by the SAYINBOX() function.
FUNCTION POPBOX
PARAMETERS pstring
PRIVATE f_top, f_left, f_bottom, f_rite, f_window
*-- retrieve the 4 screen coordinates from prefix 4 byte string
f_top = ASC( SUBSTR(pstring,1,1) )
f_left = ASC( SUBSTR(pstring,2,1) )
f_bottom = ASC( SUBSTR(pstring,3,1) )
f_right = ASC( SUBSTR(pstring,4,1) )
RESTSCREEN( f_top, f_left, f_bottom, f_right, SUBSTR(pstring,5) )
RETURN .T.